home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / fftpack / cfftf1.f < prev    next >
Text File  |  1995-12-14  |  2KB  |  63 lines
  1.       subroutine cfftf1 (n,c,ch,wa,ifac)
  2.       implicit double precision (a-h,o-z)
  3.       dimension       ch(*)      ,c(*)       ,wa(*)      ,ifac(*)
  4.       nf = ifac(2)
  5.       na = 0
  6.       l1 = 1
  7.       iw = 1
  8.       do 116 k1=1,nf
  9.          ip = ifac(k1+2)
  10.          l2 = ip*l1
  11.          ido = n/l2
  12.          idot = ido+ido
  13.          idl1 = idot*l1
  14.          if (ip .ne. 4) go to 103
  15.          ix2 = iw+idot
  16.          ix3 = ix2+idot
  17.          if (na .ne. 0) go to 101
  18.          call passf4 (idot,l1,c,ch,wa(iw),wa(ix2),wa(ix3))
  19.          go to 102
  20.   101    call passf4 (idot,l1,ch,c,wa(iw),wa(ix2),wa(ix3))
  21.   102    na = 1-na
  22.          go to 115
  23.   103    if (ip .ne. 2) go to 106
  24.          if (na .ne. 0) go to 104
  25.          call passf2 (idot,l1,c,ch,wa(iw))
  26.          go to 105
  27.   104    call passf2 (idot,l1,ch,c,wa(iw))
  28.   105    na = 1-na
  29.          go to 115
  30.   106    if (ip .ne. 3) go to 109
  31.          ix2 = iw+idot
  32.          if (na .ne. 0) go to 107
  33.          call passf3 (idot,l1,c,ch,wa(iw),wa(ix2))
  34.          go to 108
  35.   107    call passf3 (idot,l1,ch,c,wa(iw),wa(ix2))
  36.   108    na = 1-na
  37.          go to 115
  38.   109    if (ip .ne. 5) go to 112
  39.          ix2 = iw+idot
  40.          ix3 = ix2+idot
  41.          ix4 = ix3+idot
  42.          if (na .ne. 0) go to 110
  43.          call passf5 (idot,l1,c,ch,wa(iw),wa(ix2),wa(ix3),wa(ix4))
  44.          go to 111
  45.   110    call passf5 (idot,l1,ch,c,wa(iw),wa(ix2),wa(ix3),wa(ix4))
  46.   111    na = 1-na
  47.          go to 115
  48.   112    if (na .ne. 0) go to 113
  49.          call passf (nac,idot,ip,l1,idl1,c,c,c,ch,ch,wa(iw))
  50.          go to 114
  51.   113    call passf (nac,idot,ip,l1,idl1,ch,ch,ch,c,c,wa(iw))
  52.   114    if (nac .ne. 0) na = 1-na
  53.   115    l1 = l2
  54.          iw = iw+(ip-1)*idot
  55.   116 continue
  56.       if (na .eq. 0) return
  57.       n2 = n+n
  58.       do 117 i=1,n2
  59.          c(i) = ch(i)
  60.   117 continue
  61.       return
  62.       end
  63.